home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / teglp.zip / SAMPROGS.ZIP / ANIMOOP.PAS next >
Pascal/Delphi Source File  |  1990-03-15  |  1KB  |  48 lines
  1. {$F+}
  2. USES Graph,crt,SoundUnt,FastGrph,TEGLUnit,Animate,TEGLIcon;
  3.  
  4. var BounceIcon     : AnimateObject;
  5.  
  6. BEGIN
  7.    EGA640x350x16;
  8.  
  9.    setfillStyle(widedotfill,lightgray);
  10.    bar(0,0,getmaxx,getmaxy);
  11.  
  12.    with BounceIcon do
  13.       begin
  14.      init;
  15.      addframe(@imageblankbut,-15,-3,14,37,10,0,0,black);
  16.      addframe(@imageblankbut,-15,3,14,37,10,0,0,black);
  17.      addframe(@imageblankbut,-15,3,14,37,10,0,0,black);
  18.      addframe(@imageblankbut,-15,-3,14,37,10,0,0,black);
  19.      sequence(1);
  20.  
  21.      ResetSequence;
  22.      addframe(@imageblankbut,15,-3,14,37,10,0,0,black);
  23.      addframe(@imageblankbut,15,3,14,37,10,0,0,black);
  24.      addframe(@imageblankbut,15,3,14,37,10,0,0,black);
  25.      addframe(@imageblankbut,15,-3,14,37,10,0,0,black);
  26.      sequence(2);
  27.  
  28.      Animateinit;
  29.      Origin(getmaxx div 2,getmaxy div 2);
  30.  
  31.      ClearKeyBoardBuf;
  32.      while not keypressed do
  33.         begin
  34.            sequence(1);
  35.            ResetFrame(0);
  36.            Animate(Destination(36,0));
  37.            Beep(1500,1,1);
  38.  
  39.            sequence(2);
  40.            ResetFrame(0);
  41.            Animate(Destination(560,0));
  42.            Beep(1500,1,1);
  43.         end;
  44.       end;
  45.  
  46.    ABORT('BYE...');
  47. END.
  48.